home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 21
/
Cream of the Crop 21 (Terry Blount) (October 1996).iso
/
os2
/
freetype.zip
/
ttzoom.pas
< prev
Wrap
Pascal/Delphi Source File
|
1996-08-30
|
6KB
|
343 lines
program TrueType_Show;
uses Crt, TTDisp, TTTypes, TTCalc, TTTables, Raster;
{ $DEFINE DEBUG}
{$DEFINE VISUAL}
(* Ce petit programme a la prétention d'afficher les glyphes qui constituent
les caractères des fontes TrueType *)
const
Precis = 64;
Precis2 = Precis div 2;
PrecisAux = 1024;
Centre_X : int = 320;
Centre_Y : int = 225;
Profile_Buff_Size = 64000;
var
Font_Buffer : PStorage;
curGlyphContours : PGlyphContours;
num_pts : word;
num_ctr : word;
glyfArray : word;
epts_ctr : PShortArray;
xCoord : PStorage;
yCoord : PStorage;
Flag : PByteArray;
ymin, ymax, xmax, xmin, xsize : longint;
res, resB : int;
resR : real;
resX, resY : real;
LastX, LastY : FixedPoint;
numPoints, numContours : int;
curGlyph : ^TGlyph;
curGlyphContour : PGlyphContour;
Bit : TRasterBlock;
yCur : integer;
ScXMax, ScYMax,
CntX, CntY : Integer;
Rotation : int; (* Angle modulo 1024 *)
Procedure InitRows;
var
i: integer;
P: Pointer;
begin
Bit.rows := 450;
Bit.cols := 80;
Bit.width := 640;
Bit.flow := TTFlowUp;
Bit.size := 80*450;
GetMem( Bit.buffer, Bit.size );
if Bit.buffer = NIL then
begin
Writeln('ERREUR:InitRows:Pas assez de mémoire pour le BitMap');
halt(1);
end;
GetMem( P, Profile_Buff_Size );
if P=nil then
begin
writeln('ERREUR:InitRows:Pas assez de mémoire pour le buffer profils');
Halt(2);
end;
InitRasterizer( Bit, P, Profile_Buff_Size );
FillChar( Bit.Buffer^, Bit.Size, 0 );
end;
Procedure ClearData;
var i: integer;
begin
FillChar( Bit.Buffer^, Bit.Size, 0 );
FreeMem( XCoord, SizeOf(FixedPoint)*numPoints );
FreeMem( YCoord, SizeOf(FixedPoint)*numPoints );
FreeMem( Flag, numPoints );
end;
Function LoadTrueTypeChar( idx : integer ) : boolean;
var
off : longint;
x, y : Real;
i, szp : integer;
j : word;
c, ct : byte;
Gl : TGlyph;
EM : Word;
CR, SR : Real;
begin
LoadtrueTypeChar:=FALSE;
if (idx<0) or (idx>=Num_Glyphs) then exit;
CurGlyph := @Glyphs^[idx];
Gl := CurGlyph^;
numPoints := Gl.numberOfPoints;
numContours := Gl.numberOfContours;
curGlyphContours := Gl.Contours;
GetMem( XCoord, SizeOf(Fixed)*numPoints );
GetMem( YCoord, SizeOf(Fixed)*numPoints );
GetMem( Flag, numPoints );
xMin := Gl.xMin;
xMax := Gl.xMax;
yMin := Gl.yMin;
yMax := Gl.yMax;
EM := Font_Header^.UnitsPerEM;
dec( xMax, xMin );
dec( yMax, yMin );
dec ( res );
resR := res/EM/2;
xmax := trunc( xmax * resR + 0.5 );
ymax := trunc( ymax * resR + 0.5 );
CR := Cos( Rotation*Pi/512 );
SR := Sin( Rotation*Pi/512 );
for j:=0 to numPoints-1 do
begin
x := Gl.Points^[j].x * ( res / EM );
y := Gl.Points^[j].y * ( res / EM );
off := Trunc( Precis*( CR*(x-xmax) + SR*(y-ymax) ) );
XCoord^[j] := Precis*Centre_X + off;
XCoord^[j] := Precis*( Centre_X + off div Precis ) + Precis2;
off := Trunc( Precis*( - SR*(x-xmax) + CR*(y-ymax) ) );
YCoord^[j] := Precis*Centre_Y + off;
YCoord^[j] := Precis*( Centre_Y + off div Precis ) + Precis2;
Flag^[j] := Gl.Points^[j].flag and 1;
end;
inc ( res );
resR := 1/res;
xsize := ( xmax + 7 ) div 8;
LoadTrueTypeChar:=TRUE;
end;
function ConvertRaster : boolean;
var
B : Array[0..128] of Integer;
i : integer;
G : TGlyphRecord;
begin
for i := 0 to numContours-1 do
B[i] := CurGlyphContours^[i].Finish;
G.Outlines := numContours;
G.OutStarts := @B;
G.Points := numPoints;
G.XCoord := XCoord;
G.YCoord := YCoord;
G.Flag := Flag;
ConvertRaster := RenderGlyph ( G, res, res );
end;
var i: integer;
heure,
min1,
min2,
sec1,
sec2,
cent1,
cent2 :
{$IFDEF OS2}
longint;
{$ELSE}
word;
{$ENDIF}
C : Char;
Filename : String;
label Fin;
var
Fail : Int;
begin
TextMode( co80+Font8x8 );
GetMem ( Font_Buffer, 64000 );
InitBuffer( Font_Buffer^, 64000 );
curGlyphContours:=NIL;
num_pts :=0;
num_ctr :=0;
xCoord :=NIL;
yCoord :=NIL;
Flag :=NIL;
for i:=0 to ParamCount do Writeln(ParamStr(i));
If paramCount<>1 then
begin
Writeln('Usage : ',paramStr(0),' FontName[.TTF]');
Halt(1);
end;
Filename := ParamStr(1);
if Pos('.',FileName)=0 then FileName:=FileName+'.TTF';
if not Open_TrueType_File(Filename ) then
begin
Writeln('Erreur, le fichier ',ParamStr(1),' n''a pu être ouvert');
Halt(1);
end;
res := 450;
resB := (res+7) div 8;
Rotation := 0;
Fail := 0;
Load_TrueType_Tables;
Load_TrueType_MaxProfile;
if Load_TrueType_Glyphs=0 then
begin
Writeln('Problème lors du chargement des glyphes');
Halt(1);
end;
InitRows;
SetGraphScreen;
I := 1;
res := 640;
Repeat
if LoadtrueTypeChar(i) then
if ConvertRaster then
Display( Bit.Buffer^, 450, 80 )
else
inc( Fail );
C:=Readkey;
Case C of
#27 : goto Fin;
#0 : begin
C:=Readkey;
Case C of
#115 : if i>10 then dec(i,10) else i:=0;
#116 : if i < Num_Glyphs-11 then inc(i,10)
else i:=Num_Glyphs-1;
#75 : if i>0 then dec(i);
#77 : if i< Num_Glyphs-1 then inc(i);
#72 : if res > 0 then dec(res);
#80 : if res < 450 then inc(res);
end;
end;
'<' : Rotation := ( Rotation - 1 ) and 1023;
'>' : Rotation := ( Rotation + 1 ) and 1023;
';' : Rotation := ( Rotation - 16 ) and 1023;
':' : Rotation := ( Rotation + 16 ) and 1023;
'+' : if res < 1040 then inc(res,10) else
res := 1050;
'-' : if res > 11 then dec(res,10) else
res := 1;
end;
ClearData;
Until false;
Fin:
RestoreScreen;
Close_TrueType_File;
Writeln('Echecs : ', Fail );
end.